home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / evpoly.c < prev    next >
C/C++ Source or Header  |  1992-11-21  |  5KB  |  185 lines
  1. /* evpoly.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     doublereal value[200000];
  12. } blank_;
  13.  
  14. #define blank_1 blank_
  15.  
  16. /*<       subroutine evpoly(result,itype,lcoef,ncoef,larg, >*/
  17. /*<      1  narg,lexp) >*/
  18. /* Subroutine */ int evpoly_(result, itype, lcoef, ncoef, larg, narg, lexp)
  19. doublereal *result;
  20. integer *itype, *lcoef, *ncoef, *larg, *narg, *lexp;
  21. {
  22.     /* System generated locals */
  23.     integer i_1, i_2, i_3;
  24.  
  25.     /* Local variables */
  26.     extern /* Subroutine */ int zero4_();
  27.     static integer i, j;
  28. #define nodplc ((integer *)&blank_1)
  29. #define cvalue ((complex *)&blank_1)
  30.     extern /* Subroutine */ int evterm_(), nxtpwr_();
  31.     static doublereal arg, val, arg1;
  32.  
  33. /*<       implicit double precision (a-h,o-z) >*/
  34.  
  35. /*     this routine evaluates a polynomial.  lcoef points to the coef- */
  36. /* ficients, and larg points to the values of the polynomial argument(s). 
  37. */
  38.  
  39. /* spice version 2g.6  sccsid=blank 3/15/83 */
  40. /*<       common /blank/ value(200000) >*/
  41. /*<       integer nodplc(64) >*/
  42. /*<       complex cvalue(32) >*/
  43. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  44.  
  45.  
  46. /*<       if (itype) 100,200,300 >*/
  47.     if (*itype < 0) {
  48.     goto L100;
  49.     } else if (*itype == 0) {
  50.     goto L200;
  51.     } else {
  52.     goto L300;
  53.     }
  54.  
  55. /*  integration (polynomial *must* be one-dimensional) */
  56.  
  57. /*<   100 result=0.0d0 >*/
  58. L100:
  59.     *result = 0.;
  60. /*<       arg=1.0d0 >*/
  61.     arg = 1.;
  62. /*<       arg1=value(larg+1) >*/
  63.     arg1 = blank_1.value[*larg];
  64. /*<       do 110 i=1,ncoef >*/
  65.     i_1 = *ncoef;
  66.     for (i = 1; i <= i_1; ++i) {
  67. /*<       arg=arg*arg1 >*/
  68.     arg *= arg1;
  69. /*<       result=result+value(lcoef+i)*arg/dble(i) >*/
  70.     *result += blank_1.value[*lcoef + i - 1] * arg / (doublereal) i;
  71. /*<   110 continue >*/
  72. /* L110: */
  73.     }
  74. /*<       go to 1000 >*/
  75.     goto L1000;
  76.  
  77. /*  evaluation of the polynomial */
  78.  
  79. /*<   200 result=value(lcoef+1) >*/
  80. L200:
  81.     *result = blank_1.value[*lcoef];
  82. /*<       if (ncoef.eq.1) go to 1000 >*/
  83.     if (*ncoef == 1) {
  84.     goto L1000;
  85.     }
  86. /*<       call zero4(nodplc(lexp+1),narg) >*/
  87.     zero4_(&nodplc[*lexp], narg);
  88. /*<       do 220 i=2,ncoef >*/
  89.     i_1 = *ncoef;
  90.     for (i = 2; i <= i_1; ++i) {
  91. /*<       call nxtpwr(nodplc(lexp+1),narg) >*/
  92.     nxtpwr_(&nodplc[*lexp], narg);
  93. /*<       if (value(lcoef+i).eq.0.0d0) go to 220 >*/
  94.     if (blank_1.value[*lcoef + i - 1] == 0.) {
  95.         goto L220;
  96.     }
  97. /*<       arg=1.0d0 >*/
  98.     arg = 1.;
  99. /*<       do 210 j=1,narg >*/
  100.     i_2 = *narg;
  101.     for (j = 1; j <= i_2; ++j) {
  102. /*<       call evterm(val,value(larg+j),nodplc(lexp+j)) >*/
  103.         evterm_(&val, &blank_1.value[*larg + j - 1], &nodplc[*lexp + j - 
  104.             1]);
  105. /*<       arg=arg*val >*/
  106.         arg *= val;
  107. /*<   210 continue >*/
  108. /* L210: */
  109.     }
  110. /*<       result=result+value(lcoef+i)*arg >*/
  111.     *result += blank_1.value[*lcoef + i - 1] * arg;
  112. /*<   220 continue >*/
  113. L220:
  114.     ;}
  115. /*<       go to 1000 >*/
  116.     goto L1000;
  117.  
  118. /*  partial derivative with respect to the itype*th variable */
  119.  
  120. /*<   300 result=0.0d0 >*/
  121. L300:
  122.     *result = 0.;
  123. /*<       if (ncoef.eq.1) go to 1000 >*/
  124.     if (*ncoef == 1) {
  125.     goto L1000;
  126.     }
  127. /*<       call zero4(nodplc(lexp+1),narg) >*/
  128.     zero4_(&nodplc[*lexp], narg);
  129. /*<       do 330 i=2,ncoef >*/
  130.     i_1 = *ncoef;
  131.     for (i = 2; i <= i_1; ++i) {
  132. /*<       call nxtpwr(nodplc(lexp+1),narg) >*/
  133.     nxtpwr_(&nodplc[*lexp], narg);
  134. /*<       if (nodplc(lexp+itype).eq.0) go to 330 >*/
  135.     if (nodplc[*lexp + *itype - 1] == 0) {
  136.         goto L330;
  137.     }
  138. /*<       if (value(lcoef+i).eq.0.0d0) go to 330 >*/
  139.     if (blank_1.value[*lcoef + i - 1] == 0.) {
  140.         goto L330;
  141.     }
  142. /*<       arg=1.0d0 >*/
  143.     arg = 1.;
  144. /*<       do 320 j=1,narg >*/
  145.     i_2 = *narg;
  146.     for (j = 1; j <= i_2; ++j) {
  147. /*<       if (j.eq.itype) go to 310 >*/
  148.         if (j == *itype) {
  149.         goto L310;
  150.         }
  151. /*<       call evterm(val,value(larg+j),nodplc(lexp+j)) >*/
  152.         evterm_(&val, &blank_1.value[*larg + j - 1], &nodplc[*lexp + j - 
  153.             1]);
  154. /*<       arg=arg*val >*/
  155.         arg *= val;
  156. /*<       go to 320 >*/
  157.         goto L320;
  158. /*<   310 call evterm(val,value(larg+j),nodplc(lexp+j)-1) >*/
  159. L310:
  160.         i_3 = nodplc[*lexp + j - 1] - 1;
  161.         evterm_(&val, &blank_1.value[*larg + j - 1], &i_3);
  162. /*<       arg=arg*dble(nodplc(lexp+j))*val >*/
  163.         arg = arg * (doublereal) nodplc[*lexp + j - 1] * val;
  164. /*<   320 continue >*/
  165. L320:
  166.     ;}
  167. /*<       result=result+value(lcoef+i)*arg >*/
  168.     *result += blank_1.value[*lcoef + i - 1] * arg;
  169. /*<   330 continue >*/
  170. L330:
  171.     ;}
  172.  
  173. /*  finished */
  174.  
  175. /*<  1000 return >*/
  176. L1000:
  177.     return 0;
  178. /*<       end >*/
  179. } /* evpoly_ */
  180.  
  181. #undef cvalue
  182. #undef nodplc
  183.  
  184.  
  185.